home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 19 / bix01.zip / STRUCT.LIB < prev    next >
Text File  |  1986-07-07  |  3KB  |  106 lines
  1.  
  2.  
  3. {
  4.                  procedure and functions in this library
  5.  
  6.   ASwap              swaps any two data structures w/the same size
  7.   Identical          checks if two data structures are identical
  8.   Any                gets next element out of a set (if any)
  9.  
  10. }
  11.  
  12. procedure ASwap(var A1Addr,A2Addr; Size : Integer);
  13. {
  14.        purpose       swaps A <-> B; see p. 130 of TURBO Reference Manual
  15.        last update   23 Jun 85
  16. }
  17. type
  18.   DummyArray         = array[1..MaxInt] of Byte;
  19. var
  20.   A1                 : DummyArray absolute A1Addr;
  21.   A2                 : DummyArray absolute A2Addr;
  22.   Temp               : Byte;
  23.   Indx               : Integer;
  24. begin
  25.   for Indx := 1 to Size do begin
  26.     Temp     := A1[Indx];
  27.     A1[Indx] := A2[Indx];
  28.     A2[Indx] := Temp
  29.   end
  30. end; { of proc ASwap }
  31.  
  32. function Identical(var A1Addr,A2Addr; Size : Integer) : Boolean;
  33. {
  34.        purpose       check for identical data structures
  35.        last update   23 Jun 85
  36. }
  37. type
  38.   DummyArray         = array[1..MaxInt] of Byte;
  39. var
  40.   A1                 : DummyArray absolute A1Addr;
  41.   A2                 : DummyArray absolute A2Addr;
  42.   Indx               : Integer;
  43. begin
  44.   Identical := False;
  45.   for Indx := 1 to Size do
  46.     if A1[Indx] <> A2[Indx]
  47.       then Exit;
  48.   Identical := True
  49. end; { of func Identical }
  50.  
  51. function Any(var SetAddr,VAddr; Size : Integer) : Boolean;
  52. {
  53.        purpose       remove lowest element in SetAddr
  54.  
  55.        note:         for any scalar type, you can pass this
  56.                      function a set of that type, a variable
  57.                      of that type, and the size of the set.
  58.                      If the set is empty, then Any returns False;
  59.                      otherwise, it returns True, places the lowest
  60.                      (ordinal) element into VAdrr, and removes that
  61.                      same element from SetAddr.  In other words, given
  62.                      the declarations
  63.                          var
  64.                            Scale       : <scalar type>;
  65.                            ScaleSet    : set of <scalar type>;
  66.                      then the loop
  67.                          while Any(ScaleSet,Scale,SizeOf(ScaleSet)) do begin
  68.                            ...
  69.                          end;
  70.                      will execute once for each element in ScaleSet, setting
  71.                      Scale to that element.
  72.  
  73.        last update   23 Jun 85
  74. }
  75. {$R-} { make sure range checking is off }
  76. type
  77.   DummySet           = array[1..32] of Byte;
  78. var
  79.   theSet             : DummySet absolute SetAddr;
  80.   SVal               : Byte absolute VAddr;
  81.   Indx,TVal          : Integer;
  82.   IVal,Mask          : Byte;
  83. begin
  84.   TVal := 0;
  85.   Indx := 1;
  86.   while (theSet[Indx] = 0) and (Indx <= Size) do begin
  87.     Indx := Indx + 1;
  88.     TVal := TVal + 8
  89.   end;
  90.   if Indx > Size then begin
  91.     Any := False;
  92.     SVal := 0
  93.   end
  94.   else begin
  95.     Any := True;
  96.     IVal := theSet[Indx];
  97.     Mask := $01;
  98.     while (Mask > 0) and (IVal and Mask = 0) do begin
  99.       TVal := TVal + 1;
  100.       Mask := Mask shl 1
  101.     end;
  102.     theSet[Indx] := IVal xor Mask;
  103.     SVal := TVal
  104.   end
  105. end; { of func Any }
  106.